home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / comm / www / WebYAM.lha / yam.rexx < prev   
OS/2 REXX Batch file  |  2000-11-09  |  30KB  |  910 lines
  1. /*
  2. ** $VER: WebYAM 1.2 (9.11.2000)
  3. ** © 2000 by Jacob Laursen <laursen@myself.com>
  4. **
  5. ** Web browse YAM folders
  6. **
  7. ** Requirements: Apache (or some other web server)
  8. **               YAM 2.2
  9. **
  10. ** For "quoted printable" -> "8bit" conversion, please download
  11. ** comm/mail/YToolsNG.lha from Aminet and copy the file 'YTCunmime'
  12. ** to the YAM: directory, or correct the path below.
  13. **
  14. ** Version 1.2 - Optimized folder scan drastically (YAM 2.2 feature)
  15. **               Added advanced compose mode
  16. **               One more security exploit eliminated
  17. **                 (HTML tags in subject wasn't translated)
  18. **               Signature is no longer added if "Add signature"
  19. **                 is de-selected (work-around for bug in YAM).
  20. **
  21. ** Version 1.1 - Added configuration options
  22. **             - Added URL links in mails
  23. **             - Improved security (exploit eliminated)
  24. **             - Two separators in a row is now supported
  25. **
  26. ** Version 1.0 - Initial release.
  27. **
  28. ** TODO:
  29. ** - Process headers (and don't show irrelevant header lines)
  30. ** - Join "Folders" and "Folders (full)".
  31. */
  32.  
  33. options results
  34. options failat 11
  35.  
  36. /* YAM executable path */
  37. YAMPath = 'YAM:YAM'
  38.  
  39. /* YAM folder file */
  40. Cfg.YAMFolders = 'YAM:.folders'
  41.  
  42. /* WebYAM config file */
  43. Cfg.WebYAM = 'WebYAM.config'
  44.  
  45. /* YTCunmime executable path */
  46. Cfg.UMPath = 'YAM:YTCunmime'
  47.  
  48. /* Misc. appearance options */
  49. Cfg.MsgsPerPage  = 25 /* Number of messages per page            */
  50. Cfg.NumColsQuick =  4 /* Number of columns in quick folder list */
  51. Cfg.NumColsFull  =  2 /* Number of columns in full folder list  */
  52.  
  53. /* Color settings - only RRGGBB values accepted */
  54. Cfg.FldrHdrColor = '333366'
  55. Cfg.BgColor      = 'eeeecc'
  56.  
  57. /* No user-serviceable parts below... */
  58.  
  59.   say 'Content-type: text/html'; say ''
  60.  
  61.   say '<HTML>'; say ''
  62.   say '  <HEAD>'
  63.   say '    <TITLE>Yet Another Mailer - Web Interface</TITLE>'
  64.  
  65.   if ~show('P','YAM') then do
  66.     say '    <META HTTP-EQUIV="Refresh" CONTENT=30>'
  67.     say '  </HEAD>'; say ''
  68.     say '  <BODY BGCOLOR="#ffffff" TEXT="#000000">'
  69.     say '    <P>Please wait, loading YAM...</P>'
  70.     say '  </BODY>'
  71.     say '</HTML>'
  72.     address command 'Run <>NIL: ' || YAMPath || ' HIDE'
  73.     exit
  74.   end
  75.  
  76.   say '  </HEAD>'; say ''
  77.   say '  <BODY BGCOLOR="#ffffff" TEXT="#000000">'
  78.  
  79.   if ~show('L','rexxdossupport.library') then if ~addlib('rexxdossupport.library',0,-30,0) then do
  80.     say '    <P>Error: rexxdossupport.library couldn''t be opened!</P>'
  81.     say '  </BODY>'
  82.     say '</HTML>'
  83.     exit 10
  84.   end
  85.  
  86.   'getvar QUERY_STRING'; query = result
  87.   call ParseConfig
  88.   call ParseArgs(query)
  89.  
  90.   address 'YAM'
  91.  
  92.   /* YAM Version check */
  93.   INFO 'VERSION'
  94.   parse var RESULT '$VER: YAM ' major '.' minor .
  95.   if datatype(major) = 'NUM' & datatype(minor) = 'NUM' then do
  96.     if major < 2 | (major = 2 & minor < 2) then do
  97.     say '    <P>YAM 2.2 required (installed version: 'major'.'minor').</P>'
  98.     say '  </BODY>'
  99.     say '</HTML>'
  100.     exit 10
  101.   end
  102.  
  103.   if Arg.Check = 1 then call GetMail
  104.   if Arg.Save  = 1 then call SaveConfig
  105.   if Arg.Help  = 1 then call Help
  106.   else if Arg.Config = 1 then call Config
  107.   else if Arg.Compose = 1 then call ComposeMail
  108.   else if Arg.Send = 1 then call SendMail
  109.   else if Arg.List = 1 then call ListFolders
  110.   else if Arg.Folder > -1 then do
  111.     if Arg.Message > -1 then do
  112.       if Arg.Move = 1 then call MoveMail
  113.       else if Arg.Delete = 1 then call DeleteMail
  114.       else call ReadMessage(Arg.Folder, Arg.Message)
  115.     end
  116.     else do
  117.       if Arg.Move = 1 then call MoveMails(Arg.Folder, Arg.Page)
  118.       else if Arg.Delete = 1 then call DeleteMails(Arg.Folder, Arg.Page)
  119.       else call ListFolder(Arg.Folder, Arg.Page)
  120.     end
  121.   end
  122.   else call ListDeadFolders
  123.  
  124.   say '  </BODY>'
  125.   say '</HTML>'
  126.  
  127. exit
  128.  
  129.  
  130. ParseArgs: PROCEDURE EXPOSE Arg. Cfg.
  131. parse arg string
  132.  
  133.   Arg.List       =  0
  134.   Arg.Check      =  0
  135.   Arg.Config     =  0
  136.   Arg.Help       =  0
  137.   Arg.Compose    =  0
  138.   Arg.Advanced   =  0
  139.   Arg.Send       =  0
  140.   Arg.Save       =  0
  141.   Arg.Signature  =  0
  142.   Arg.Keep       =  1
  143.   Arg.Folder     = -1
  144.   Arg.DestFolder = -1
  145.   Arg.Message    = -1
  146.   Arg.Page       =  1
  147.  
  148.   Arg.Delete     = 0
  149.   Arg.Move       = 0
  150.   Arg.Msgs.COUNT = 0
  151.  
  152.   Arg.From    = ''
  153.   Arg.ReplyTo = ''
  154.   Arg.Cc      = ''
  155.   Arg.Bcc     = ''
  156.  
  157.   query = translate(string, ' ', '&')
  158.   do loop = 1 to words(query)
  159.     arg = word(query,loop)
  160.     if index(arg,'=') > 1 then do
  161.       cmd = left(arg,index(arg,'=')-1)
  162.       parse var arg cmd'='value
  163.       cmd = upper(cmd)
  164.       select
  165.         when cmd = 'FOLDER'     then Arg.Folder     = value
  166.         when cmd = 'DESTFOLDER' then Arg.DestFolder = value
  167.         when cmd = 'MESSAGE'    then Arg.Message    = value
  168.         when cmd = 'PAGE'       then Arg.Page       = value
  169.         when cmd = 'OPTION' & upper(value) = 'DELETE'  then Arg.Delete = 1
  170.         when cmd = 'OPTION' & upper(value) = 'MOVE+TO' then Arg.Move   = 1
  171.         when cmd = 'SEND'   & upper(value) = 'SEND'    then Arg.Send   = 1
  172.         when cmd = 'SAVE'   & upper(value) = 'SAVE'    then Arg.Save   = 1
  173.         when cmd = 'MSGSPERPAGE'  & datatype(value) = 'NUM' then Cfg.MsgsPerPage  = value
  174.         when cmd = 'NUMCOLSQUICK' & datatype(value) = 'NUM' then Cfg.NumColsQuick = value
  175.         when cmd = 'FROM'    then Arg.From      = Convert(value)
  176.         when cmd = 'REPLYTO' then Arg.ReplyTo   = Convert(value)
  177.         when cmd = 'TO'      then Arg.Recipient = Convert(value)
  178.         when cmd = 'CC'      then Arg.Cc        = Convert(value)
  179.         when cmd = 'BCC'     then Arg.Bcc       = Convert(value)
  180.         when cmd = 'SUBJECT' then Arg.Subject   = Convert(value)
  181.         when cmd = 'BODY'    then Arg.Body      = Convert(value)
  182.         when cmd = 'SIGNATURE' & upper(value) = 'ON' then Arg.Signature = 1
  183.         when cmd = 'KEEP' & upper(value) = 'OFF' then Arg.Keep = 0
  184.         when left(cmd,8) = 'MESSAGE.' then do
  185.           parse var arg dummy'.'num'='val
  186.           current = Arg.Msgs.COUNT
  187.           if upper(val) = 'ON' then do
  188.             Arg.Msgs.current = num
  189.             Arg.Msgs.COUNT = current + 1
  190.           end
  191.         end
  192.       end
  193.     end
  194.     else do
  195.       arg = upper(arg)
  196.       if arg = 'LIST'     then Arg.List     = 1
  197.       if arg = 'CHECK'    then Arg.Check    = 1
  198.       if arg = 'CONFIG'   then Arg.Config   = 1
  199.       if arg = 'HELP'     then Arg.Help     = 1
  200.       if arg = 'COMPOSE'  then Arg.Compose  = 1
  201.       if arg = 'ADVANCED' then Arg.Advanced = 1
  202.     end
  203.  
  204.   end
  205.  
  206. return
  207.  
  208.  
  209. ParseConfig: PROCEDURE EXPOSE Cfg.
  210.  
  211.   if ~exists(Cfg.WebYAM) then return
  212.   call open(fh, Cfg.WebYAM, 'R')
  213.  
  214.   do while ~eof(fh)
  215.     line = readln(fh)
  216.     key = upper(word(line, 1))
  217.     arg = word(line, 2)
  218.     if key = 'MSGSPERPAGE' & datatype(arg) = 'NUM' then Cfg.MsgsPerPage = arg
  219.     else if key = 'NUMCOLSQUICK' & datatype(arg) = 'NUM' then Cfg.NumColsQuick = arg
  220.   end
  221.  
  222.   call close(fh)
  223.  
  224. return
  225.  
  226.  
  227. SaveConfig: PROCEDURE EXPOSE Cfg.
  228.  
  229.   call open(fh, Cfg.WebYAM, 'W')
  230.   call writeln(fh, 'MsgsPerPage 'Cfg.MsgsPerPage)
  231.   call writeln(fh, 'NumColsQuick 'Cfg.NumColsQuick)
  232.   call close(fh)
  233.  
  234. return
  235.  
  236.  
  237. ParseFolders: PROCEDURE EXPOSE Cfg.
  238.  
  239.   if ~exists(Cfg.YAMFolders) then return
  240.   call open(fh, Cfg.YAMFolders, 'R')
  241.  
  242.   Cfg.FolderName.COUNT = 0
  243.   do while ~eof(fh)
  244.     line = readln(fh)
  245.     if word(line, 1) = '@FOLDER' then do
  246.       current = Cfg.FolderName.COUNT
  247.       Cfg.FolderName.current = 'F:'right(line,length(line)-8)
  248.       Cfg.FolderName.COUNT = current + 1
  249.     end
  250.     else if word(line, 1) = '@SEPARATOR' then do
  251.       current = Cfg.FolderName.COUNT
  252.       if length(line) > 11 then Cfg.FolderName.current = 'S:'right(line,length(line)-11)
  253.       else Cfg.FolderName.current = 'S:'
  254.       Cfg.FolderName.COUNT = current + 1
  255.     end
  256.   end
  257.  
  258.   call close(fh)
  259.  
  260. return
  261.  
  262.  
  263. GotoMail: PROCEDURE
  264. parse arg num
  265.  
  266.   SETMAIL num
  267.   if RC ~= 10 then return 0
  268.   else say '    <P>This mail does not exist -- please update message list.</P>'
  269.  
  270. return 10
  271.  
  272.  
  273. GotoFolder: PROCEDURE
  274. parse arg num
  275.  
  276.   SETFOLDER num
  277.   if RC ~= 10 then return 0
  278.   else say '    <P>This folder does not exist -- please update folder list.</P>'
  279.  
  280. return 10
  281.  
  282.  
  283. Config: PROCEDURE EXPOSE Cfg.
  284.  
  285.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  286.   say '      <TR ALIGN="center">'
  287.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  288.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List&Check"><B>Get mail</B></A></TD>'
  289.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  290.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  291.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  292.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  293.   say '      </TR>'
  294.   say '    </TABLE>'
  295.  
  296.   say '    <TABLE BORDER=0 CELLSPACING=5 WIDTH="100%">'
  297.   say '      <TR BGCOLOR="#'Cfg.BgColor'" ALIGN="center">'
  298.   say '        <TD><B>Configuration</B></TD>'
  299.   say '      </TR>'
  300.   say '    </TABLE>'
  301.  
  302.   say '    <FORM NAME="composeform" ACTION="yam.rexx">'
  303.  
  304.   say '    <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=2 WIDTH="100%">'
  305.   say '      <TR><TD COLSPAN=3><HR NOSHADE SIZE=1></TD></TR>'
  306.   say '      <TR VALIGN="top">'
  307.   say '        <TD WIDTH="20%">Messages per Page</TD>'
  308.   say '        <TD><INPUT TYPE="number" NAME="MsgsPerPage" VALUE="'Cfg.MsgsPerPage'"></INPUT></TD>'
  309.   say '      </TR>'
  310.   say '      <TR><TD COLSPAN=3><HR NOSHADE SIZE=1></TD></TR>'
  311.   say '      <TR VALIGN="top">'
  312.   say '        <TD WIDTH="20%">Columns quick</TD>'
  313.   say '        <TD><INPUT TYPE="number" NAME="NumColsQuick" VALUE="'Cfg.NumColsQuick'"></INPUT></TD>'
  314.   say '      </TR>'
  315.   say '    </TABLE>'
  316.  
  317.   say '      <INPUT TYPE="submit" NAME="Save" VALUE="Save">'
  318.  
  319.   say '    </FORM>'
  320.  
  321. return
  322.  
  323.  
  324. ListFolders: PROCEDURE EXPOSE Cfg.
  325.  
  326.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  327.   say '      <TR ALIGN="center">'
  328.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  329.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List&Check"><B>Get mail</B></A></TD>'
  330.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  331.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  332.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  333.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  334.   say '      </TR>'
  335.   say '    </TABLE>'
  336.  
  337.   say '    <TABLE BORDER=0 CELLSPACING=1 WIDTH="100%">'
  338.   say '      <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  339.   say '        <TD ALIGN="left"><FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  340.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Folder</B></FONT></TD>'
  341.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Total</B></FONT></TD>'
  342.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Unread</B></FONT></TD>'
  343.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>New</B></FONT></TD>'
  344.   say '      </TR>'
  345.  
  346.   call GoBusy
  347.   USERINFO STEM uinfo.
  348.   do i = 0 to uinfo.FOLDERS-1
  349.     FOLDERINFO i STEM cfi.
  350.     if RC = 10 then iterate
  351.     say '      <TR BGCOLOR="#'Cfg.BgColor'">'
  352.     say '        <TD ALIGN="left">'cfi.NUMBER'</TD>'
  353.     say '        <TD ALIGN="left"><A HREF="yam.rexx?Folder='cfi.NUMBER'">'cfi.NAME'</A></TD>'
  354.     say '        <TD ALIGN="right">'cfi.TOTAL'</TD>'
  355.     say '        <TD ALIGN="right">'cfi.UNREAD'</TD>'
  356.     say '        <TD ALIGN="right">'cfi.NEW'</TD>'
  357.     say '      </TR>'
  358.   end
  359.   APPNOBUSY
  360.  
  361.   say '    </TABLE>'; say
  362.  
  363. return
  364.  
  365.  
  366. ListDeadFolders: PROCEDURE EXPOSE Cfg.
  367.  
  368.   if ~exists(Cfg.YAMFolders) then do
  369.     call ListFolders
  370.     return
  371.   end
  372.  
  373.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  374.   say '      <TR ALIGN="center">'
  375.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  376.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Check"><B>Get mail</B></A></TD>'
  377.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  378.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  379.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  380.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  381.   say '      </TR>'
  382.   say '    </TABLE>'
  383.  
  384.   call ParseFolders
  385.  
  386.   say '    <TABLE BORDER=0 CELLSPACING=1 WIDTH="100%">'
  387.   say '      <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  388.   do loop = 0 to Cfg.NumColsQuick-1
  389.     say '        <TD><FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  390.     say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Folder</B></FONT></TD>'
  391.   end
  392.   say '      </TR>'
  393.  
  394.   step = Cfg.FolderName.COUNT/Cfg.NumColsQuick
  395.   if trunc(step) ~= step then step = trunc(step)+1
  396.  
  397.   do mainloop = 0 to step-1
  398.     say '      <TR BGCOLOR="#'Cfg.BgColor'">'
  399.     do loop = 0 to Cfg.NumColsQuick-1
  400.       current = mainloop+loop*step
  401.       if current > Cfg.FolderName.COUNT-1 then leave
  402.       if left(cfg.FolderName.current, 2) = 'F:' then do
  403.         say '        <TD>'current'</TD>'
  404.         say '        <TD><A HREF="yam.rexx?Folder='current'">'right(cfg.FolderName.current, length(cfg.FolderName.current)-2)'</A></TD>'
  405.       end
  406.     end
  407.     say '      </TR>'
  408.   end
  409.  
  410.   say '    </TABLE>'; say
  411.  
  412. return
  413.  
  414.  
  415. DeleteMail: PROCEDURE EXPOSE Arg. Cfg.
  416.  
  417.   Arg.Msgs.COUNT = 1
  418.   Arg.Msgs.0 = Arg.Message
  419.   call DeleteMails(Arg.Folder, Arg.Page)
  420.  
  421. return
  422.  
  423.  
  424. DeleteMails: PROCEDURE EXPOSE Arg. Cfg.
  425. parse arg folder, page
  426.  
  427.   call GoBusy
  428.   RC = GotoFolder(folder)
  429.   if RC = 10 then do
  430.     APPNOBUSY
  431.     return
  432.   end
  433.  
  434.   do loop=Arg.Msgs.COUNT-1 to 0 by -1
  435.     RC = GotoMail(Arg.Msgs.loop)
  436.     if RC = 10 then leave
  437.     MAILDELETE 'FORCE'
  438.   end
  439.   APPNOBUSY
  440.  
  441.   call ListFolder(folder, page)
  442.  
  443. return
  444.  
  445.  
  446. MoveMail: PROCEDURE EXPOSE Arg. Cfg.
  447.  
  448.   Arg.Msgs.COUNT = 1
  449.   Arg.Msgs.0 = Arg.Message
  450.   call MoveMails(Arg.Folder, Arg.Page)
  451.  
  452. return
  453.  
  454.  
  455. MoveMails: PROCEDURE EXPOSE Arg. Cfg.
  456. parse arg folder, page
  457.  
  458.   call GoBusy
  459.   RC = GotoFolder(folder)
  460.   if RC = 10 then do
  461.     APPNOBUSY
  462.     return
  463.   end
  464.  
  465.   do loop=Arg.Msgs.COUNT-1 to 0 by -1
  466.     RC = GotoMail(Arg.Msgs.loop)
  467.     if RC = 10 then leave
  468.     MAILMOVE Arg.DestFolder
  469.   end
  470.   APPNOBUSY
  471.  
  472.   call ListFolder(folder, page)
  473.  
  474. return
  475.  
  476.  
  477. ListFolder: PROCEDURE EXPOSE Cfg.
  478. parse arg folder, page
  479.  
  480.   call ParseFolders
  481.   call GoBusy
  482.  
  483.   RC = GotoFolder(folder)
  484.   if RC = 10 then do
  485.     APPNOBUSY
  486.     return
  487.   end
  488.  
  489.   FOLDERINFO STEM fi.
  490.  
  491.   start = Cfg.MsgsPerPage * (page-1)
  492.   end   = Cfg.MsgsPerPage * page
  493.   if end > fi.TOTAL then end = fi.TOTAL
  494.   pages = trunc((fi.TOTAL-1)/Cfg.MsgsPerPage)+1
  495.  
  496.   say '    <FORM NAME="WebYAM" ACTION="yam.rexx">'
  497.   say '      <INPUT TYPE="hidden" NAME="Folder" VALUE="'folder'">'
  498.   say '      <INPUT TYPE="hidden" NAME="Page" VALUE="'page'">'
  499.  
  500.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  501.   say '        <TR>'
  502.   say '          <TD COLSPAN=1 ALIGN="left"><FONT SIZE=+2><B>Folder: 'right(Cfg.FolderName.folder, length(Cfg.FolderName.folder)-2)'</B></FONT></TD>'
  503.   pageinfo = '        <TD COLSPAN=4 ALIGN="right">Page 'page' of 'pages' ['
  504.   do loop = 1 to pages
  505.     if loop = page then pageinfo = pageinfo' 'loop
  506.     else pageinfo = pageinfo' <A HREF="yam.rexx?Folder='folder'&Page='loop'">'loop'</A>'
  507.   end
  508.   say pageinfo' ]</TD>'
  509.  
  510.   say '        <TR ALIGN="center">'
  511.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  512.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'&check"><B>Get mail</B></A></TD>'
  513.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  514.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  515.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  516.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  517.   say '        </TR>'
  518.   say '      </TABLE>'
  519.  
  520.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  521.   say '        <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  522.   say '          <TD><IMG SRC="pics/newmail.gif" WIDTH=11 HEIGHT=11 ALT="New" HSPACE=5></TD>'
  523.   say '          <TD HEIGHT=23> </TD>'
  524.   say '          <TD ALIGN="left"> <FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  525.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Name</B></FONT></TD>'
  526.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Subject</B></FONT></TD>'
  527.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Date</B></FONT></TD>'
  528.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Size</B></FONT></TD>'
  529.   say '          <TD ALIGN="right"><FONT COLOR="#ffffff"><B>Flags</B></FONT> </TD>'
  530.   say '        </TR>'
  531.  
  532.   do loop = start to end-1
  533.     MAILINFO loop STEM sel.
  534.  
  535.     if index(sel.FROM,'<') ~= 0 then email = left(sel.FROM,index(sel.FROM,'<')-2)
  536.     else email = sel.FROM
  537.     subj = Replace(sel.SUBJECT, '<', '<')
  538.     subj = Replace(subj, '>', '>')
  539.  
  540.     say '        <TR BGCOLOR="#'Cfg.BgColor'">'
  541.  
  542.     if sel.STATUS = 'U' | sel.STATUS = 'N' then say '         <TD><IMG SRC="pics/newmail.gif" WIDTH=11 HEIGHT=11 ALT="New" HSPACE=5></TD>'
  543.     else say '         <TD> </TD>'
  544.  
  545.     say '          <TD><INPUT TYPE="checkbox" NAME="Message.'loop'"></TD>'
  546.  
  547.     say '          <TD ALIGN="left" NOWRAP> 'sel.INDEX+1'</TD>'
  548.     estr = '          <TD ALIGN="left" NOWRAP> '
  549.     if left(sel.FLAGS,1) = 'M' then estr = estr'<IMG SRC="pics/status_group.gif" WIDTH=19 HEIGHT=9 ALT="M"> '
  550.     estr = estr'<A HREF="yam.rexx?Folder='folder'&Message='sel.INDEX'">'email'</A></TD>'
  551.     say estr
  552.     say '          <TD ALIGN="left" NOWRAP> 'subj'</TD>'
  553.     say '          <TD ALIGN="left" NOWRAP> 'sel.DATE'</TD>'
  554.     say '          <TD ALIGN="right" NOWRAP>'sel.SIZE' </TD>'
  555.  
  556.     imgstat = '          <TD ALIGN="right" NOWRAP>'
  557.     if substr(sel.FLAGS,2,1) = 'A' then imgstat = imgstat'<IMG SRC="pics/status_attach.gif" WIDTH=9 HEIGHT=10 ALT="A"> '
  558.     if substr(sel.FLAGS,3,1) = 'R' then imgstat = imgstat'<IMG SRC="pics/status_report.gif" WIDTH=6 HEIGHT=10 ALT="R"> '
  559.     if substr(sel.FLAGS,4,1) = 'C' then imgstat = imgstat'<IMG SRC="pics/status_crypt.gif" WIDTH=6 HEIGHT=9 ALT="C"> '
  560.     if substr(sel.FLAGS,5,1) = 'S' then imgstat = imgstat'<IMG SRC="pics/status_signed.gif" WIDTH=6 HEIGHT=9 ALT="S"> '
  561.     if sel.STATUS = 'O' then imgstat = imgstat'<IMG SRC="pics/status_old.gif" WIDTH=25 HEIGHT=10 ALT="O">'
  562.     else if sel.STATUS = 'N' then imgstat = imgstat'<IMG SRC="pics/status_new.gif" WIDTH=25 HEIGHT=10 ALT="N">'
  563.     else if sel.STATUS = 'R' then imgstat = imgstat'<IMG SRC="pics/status_reply.gif" WIDTH=25 HEIGHT=10 ALT="R">'
  564.     else if sel.STATUS = 'U' then imgstat = imgstat'<IMG SRC="pics/status_unread.gif" WIDTH=25 HEIGHT=10 ALT="U">'
  565.     else if sel.STATUS = 'F' then imgstat = imgstat'<IMG SRC="pics/status_forward.gif" WIDTH=25 HEIGHT=10 ALT="F">'
  566.     else if sel.STATUS = 'S' then imgstat = imgstat'<IMG SRC="pics/status_sent.gif" WIDTH=25 HEIGHT=10 ALT="S">'
  567.     else if sel.STATUS = 'W' then imgstat = imgstat'<IMG SRC="pics/status_waitsend.gif" WIDTH=25 HEIGHT=10 ALT="W">'
  568.     else if sel.STATUS = 'H' then imgstat = imgstat'<IMG SRC="pics/status_hold.gif" WIDTH=25 HEIGHT=10 ALT="H">'
  569.     else if sel.STATUS = 'E' then imgstat = imgstat'<IMG SRC="pics/status_error.gif" WIDTH=25 HEIGHT=10 ALT="E">'
  570.     say imgstat' </TD>'
  571.     say '        </TR>'
  572.   end
  573.  
  574.   APPNOBUSY
  575.  
  576.   say '        <TR><TD HEIGHT=12></TD></TR>'
  577.   say '        <TR>'
  578.   temp = '          <TD VALIGN="top" ALIGN="right" COLSPAN=8> [ '
  579.   if page = 1 then temp = temp'Prev Page'
  580.   else temp = temp'<A HREF="yam.rexx?Folder='folder'&Page='page-1'">Prev Page</A>'
  581.   temp = temp' | '
  582.   if page = pages then temp = temp'Next Page'
  583.   else temp = temp'<A HREF="yam.rexx?Folder='folder'&Page='page+1'">Next Page</A>'
  584.   say temp' ]</TD>'
  585.   say '        </TR>'
  586.   say '      </TABLE>'; say
  587.  
  588.   call MakeMoveTo(folder)
  589.  
  590.   say '    </FORM>'
  591.  
  592. return
  593.  
  594.  
  595. ReadMessage: PROCEDURE EXPOSE Cfg.
  596. parse arg folder, message
  597.  
  598.   call GoBusy
  599.   RC = GotoFolder(folder)
  600.   if RC = 10 then do
  601.     APPNOBUSY
  602.     return
  603.   end
  604.  
  605.   RC = GotoMail(message)
  606.   if RC = 10 then do
  607.     APPNOBUSY
  608.     return
  609.   end
  610.  
  611.   call ParseFolders
  612.   FOLDERINFO STEM cfi.
  613.  
  614.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  615.   say '      <TR ALIGN="center">'
  616.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  617.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'&Message='message'&Check"><B>Get mail</B></A></TD>'
  618.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'"><B>'cfi.NAME'</B></A></TD>'
  619.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  620.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  621.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  622.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  623.   say '      </TR>'
  624.   say '    </TABLE>'
  625.  
  626.   MAILEXPORT 'T:YAM-TextMode.tmp'
  627.   if exists(Cfg.UMPath) = 1 then address command Cfg.UMPath || ' MAIL=T:YAM-TextMode.tmp'
  628.   say '    <PRE>'
  629.  
  630.   call open(fh, 'T:YAM-TextMode.tmp', 'R')
  631.   do while ~eof(fh)
  632.     line = readln(fh)
  633.     if line = '-- ' then say '<HR>'
  634.     else do
  635.       line = Replace(line, '<', '<')
  636.       line = Replace(line, '>', '>')
  637.       say LinkURL(line)
  638.     end
  639.   end
  640.  
  641.   call close(fh)
  642.  
  643.   say '    </PRE>'
  644.   address command 'Delete >NIL: T:YAM-TextMode.tmp'
  645.  
  646.   MAILINFO STEM sel.
  647.   if sel.STATUS = 'N' | sel.STATUS = 'U' then MAILSTATUS 'O'
  648.  
  649.   APPNOBUSY
  650.   say '    <FORM NAME="WebYAM" ACTION="yam.rexx">'
  651.   say '      <INPUT TYPE="hidden" NAME="Folder" VALUE="'folder'">'
  652.   say '      <INPUT TYPE="hidden" NAME="Message" VALUE="'message'">'
  653.   call ParseFolders
  654.   call MakeMoveTo(folder)
  655.   say '    </FORM'
  656.  
  657. return
  658.  
  659.  
  660. GetMail: PROCEDURE
  661.  
  662.   MAILCHECK
  663.  
  664. return
  665.  
  666.  
  667. ComposeMail: PROCEDURE EXPOSE Arg.
  668.  
  669.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  670.   say '      <TR ALIGN="center">'
  671.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  672.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose&Check"><B>Get mail</B></A></TD>'
  673.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  674.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  675.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  676.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  677.   say '      </TR>'
  678.   say '    </TABLE>'
  679.  
  680.   say '    <FORM NAME="composeform" ACTION="yam.rexx">'
  681.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  682.   say '        <TR VALIGN="top">'
  683.   say '          <TD COLSPAN=2 ALIGN="center">'
  684.   say '            <INPUT TYPE="submit" NAME="Send" VALUE="Send">'
  685.   say '            <INPUT TYPE="submit" NAME="Cancel" VALUE="Cancel">'
  686.   if Arg.Advanced = 0 then
  687.     say '            <A HREF="yam.rexx?Compose&Advanced">Advanced</A>'
  688.   else
  689.     say '            <A HREF="yam.rexx?Compose">Simple</A>'
  690.   say '          </TD>'
  691.   say '        </TR>'
  692.  
  693.   if Arg.Advanced = 1 then do
  694.     say '        <TR>'
  695.     say '          <TD ALIGN="right" NOWRAP><B>From:</B></TD>'
  696.     say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="From" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  697.     say '        </TR>'
  698.     say '        <TR>'
  699.     say '          <TD ALIGN="right" NOWRAP><B>Reply-To:</B></TD>'
  700.     say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="ReplyTo" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  701.     say '        </TR>'
  702.   end
  703.  
  704.   say '        <TR>'
  705.   say '          <TD ALIGN="right" NOWRAP><B>To:</B></TD>'
  706.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="To" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  707.   say '        </TR>'
  708.   say '        <TR>'
  709.   say '          <TD ALIGN="right" NOWRAP><B>Cc:</B></TD>'
  710.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Cc" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  711.   say '        </TR>'
  712.  
  713.   if Arg.Advanced = 1 then do
  714.     say '        <TR>'
  715.     say '          <TD ALIGN="right" NOWRAP><B>Bcc:</B></TD>'
  716.     say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Bcc" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  717.     say '        </TR>'
  718.   end
  719.  
  720.   say '        <TR>'
  721.   say '          <TD ALIGN="right" NOWRAP><B>Subject:</B></TD>'
  722.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Subject" VALUE="" SIZE=65 MAXLENGTH=80</TD>'
  723.   say '        </TR>'
  724.   say '        <TR>'
  725.   say '          <TD></TD>'
  726.   say '          <TD HEIGHT=30 VALIGN="middle">'
  727.   say '            <INPUT TYPE="checkbox" NAME="Signature" VALUE="on">Add signature'
  728.   say '            <INPUT TYPE="checkbox" NAME="Keep" VALUE="off">Delete when sent'
  729.   say '          </TD>'
  730.   say '        </TR>'
  731.   say '      </TABLE>'
  732.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  733.   say '        <TR>'
  734.   say '          <TD ALIGN="center">'
  735.   say '            <TEXTAREA NAME="Body" ROWS=30 COLS=74 WRAP="soft"></TEXTAREA>'
  736.   say '          </TD>'
  737.   say '        </TR>'
  738.   say '      </TABLE>'
  739.   say '    </FORM>'
  740.  
  741. return
  742.  
  743.  
  744. SendMail: PROCEDURE EXPOSE Arg.
  745.  
  746.   call open(fh, 'T:WebYAM-write.tmp', 'W')
  747.   call writeln(fh, Arg.body)
  748.   call close(fh)
  749.  
  750.   call GoBusy
  751.  
  752.   'MAILWRITE QUIET'
  753.  
  754.   WRITETO '"'Arg.Recipient'"'
  755.   if Arg.From    ~= '' then WRITEFROM '"'Arg.From'"'
  756.   if Arg.ReplyTo ~= '' then WRITEREPLYTO '"'Arg.ReplyTo'"'
  757.   if Arg.Cc      ~= '' then WRITECC '"'Arg.Cc'"'
  758.   if Arg.Bcc     ~= '' then WRITEBCC '"'Arg.Bcc'"'
  759.   WRITESUBJECT '"'Arg.Subject'"'
  760.  
  761.   if Arg.Signature = 0 then WRITELETTER 'T:WebYAM-write.tmp' NOSIG
  762.   else WRITELETTER 'T:WebYAM-write.tmp'
  763.  
  764.   if Arg.Keep = 0 then 'WRITEOPTIONS DELETE'
  765.   else WRITEOPTIONS
  766.  
  767.   WRITESEND
  768.  
  769.   APPNOBUSY
  770.   address command 'Delete >NIL: T:WebYAM-write.tmp'
  771.  
  772.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  773.   say '      <TR ALIGN="center">'
  774.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  775.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Check"><B>Get mail</B></A></TD>'
  776.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  777.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  778.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  779.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  780.   say '      </TR>'
  781.   say '    </TABLE>'
  782.   say '    <BR>'
  783.   say '    <H2>Your mail was succesfully sent.</H2>'
  784.  
  785. return
  786.  
  787.  
  788. Help: PROCEDURE
  789.  
  790.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  791.   say '      <TR ALIGN="center">'
  792.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  793.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help&Check"><B>Get mail</B></A></TD>'
  794.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  795.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  796.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Config"><B>Config</B></A></TD>'
  797.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  798.   say '      </TR>'
  799.   say '    </TABLE>'
  800.   say '    <BR>'
  801.  
  802.   say '    <H1>WebYAM 1.2 by Jacob Laursen</H1>'; say
  803.   say '    <P>Browse your YAM folders through the World Wide Web.</P>'
  804.   say '    <P>'
  805.   say '      Author''s e-mail address: <A HREF="mailto:laursen@myself.com">laursen@myself.com</A><BR>'
  806.   say '      WebYAM homepage: <A HREF="http://home.worldonline.dk/~jlaur/amiga/webyam/">http://home.worldonline.dk/~jlaur/amiga/webyam/</A><BR>'
  807.   say '      Status icons by Ash Thomas'
  808.   say '    </P>'
  809.  
  810. return
  811.  
  812.  
  813. Convert: PROCEDURE
  814. parse arg dummy
  815.  
  816.   dummy = translate(dummy, ' ', '+')
  817.   do until pos=0
  818.     pos=index(dummy,'%')
  819.     if pos>0 then do
  820.       hex=substr(dummy,pos+1,2)
  821.       char=x2c(hex)
  822.       if pos=1 then dummy=char||substr(dummy,pos+3)
  823.       if pos>1 & pos<length(dummy)-2 then dummy=left(dummy,pos-1)||char||substr(dummy,pos+3)
  824.       if pos=length(dummy)-2 then dummy=left(dummy,pos-1)||char
  825.     end
  826.   end
  827.  
  828. return dummy
  829.  
  830.  
  831. GoBusy: PROCEDURE
  832.  
  833.   APPBUSY 'TEXT="WebYAM is working, please wait..."'
  834.  
  835. return
  836.  
  837.  
  838. MakeMoveTo: PROCEDURE EXPOSE Cfg.
  839. parse arg folder
  840.  
  841.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  842.   say '        <TR>'
  843.   say '          <TD ALIGN="center"><INPUT TYPE="submit" NAME="Option" VALUE="Move to"></TD>'
  844.   say '          <TD ALIGN="left" COLSPAN=2><SELECT NAME="DestFolder">'
  845.   do loop = 0 to Cfg.FolderName.COUNT-1
  846.     if loop = folder then iterate
  847.     if left(Cfg.FolderName.loop, 2) = 'F:' then say '            <OPTION VALUE="'loop'">'right(Cfg.FolderName.loop,length(Cfg.FolderName.loop)-2)
  848.   end
  849.   say '          </SELECT></TD>'
  850.   say '        </TR>'
  851.   say '        <TR>'
  852.   say '          <TD ALIGN="center"><INPUT TYPE="submit" NAME="Option" VALUE="Delete"></TD>'
  853.   say '        </TR>'
  854.   say '      </TABLE>'
  855.  
  856. return
  857.  
  858.  
  859. Replace: PROCEDURE
  860. parse arg String,Old,New
  861.  
  862.   do while index(String,Old) ~= 0
  863.     interpret "parse var String left '"Old"' right"
  864.     String = left || New || right
  865.   end
  866.  
  867. return String
  868.  
  869.  
  870. LinkURL: PROCEDURE
  871. parse arg line
  872.  
  873.   p = index(line, 'http://')
  874.   q = index(line, 'www')
  875.  
  876.   if p ~= 0 | q ~= 0 then do
  877.     if p = 0 | (p > q & q > 0) then p = q
  878.  
  879.     len = length(line)
  880.     l = left(line, p-1)
  881.  
  882.     /* URL start position: len-p+1 */
  883.  
  884.     url = right(line, len-p+1)
  885.     /* This is the URL followed by the rest of the line */
  886.  
  887.     parse var url url .
  888.     /* Cut what we know for sure is not a part of the URL */
  889.  
  890.     i = length(url)
  891.     c = substr(url, i, 1)
  892.     do while ~datatype(c, 'ALPHANUMERIC') & c ~= '/' & i > 1
  893.       i = i - 1
  894.       c = substr(url, i, 1)
  895.     end
  896.     if i > 1 then url = left(url, i)
  897.     else url = ''
  898.  
  899.     r = right(line, length(line)-length(url)-p+1)
  900.  
  901.     if left(url, 7) ~= 'http://' then ref = 'http://' || url
  902.     else ref = url
  903.  
  904.     return l || '<A HREF="' || ref || '">' || url || '</A>' || LinkURL(r)
  905.     /* Recurse until all references have been made */
  906.  
  907.   end
  908.  
  909. return line
  910.